1.Introduction

ホテル（宿泊施設）や観光施設においては、宿泊者や来訪者のデータの分析を行い、事業戦略上の意思決定に繋げようとする試みが以前に比べ活発化しています。宿泊者や来訪者の特性を主観的ではなく客観的に捉え直すことで意思決定の精度の向上も期待できます。 宿泊者や来訪者の特性を把握するにあたり、彼（彼女）らの居住地に注目することで、当該施設がどの地域の人たちに比較的支持されているが明確になります。また、近年、ホテル（宿泊施設）や観光施設の宿泊者数や来訪者数の予測を行う施設も増えてきました。単にモデル構築するだけでなく、新しい情報が発生すれば、過去の知識を即座に修正し再びモデルを構築するような「学習機能」にも注目が集まっています。 本稿では、和歌山市内に立地するゲストハウスGuest House Ricoの宿泊者情報を用いて、1.宿泊者の居住地の特性把握、2.宿泊者数の予測モデル構築を試みます。1.については、外国人宿泊者と日本人宿泊者に分けて、宿泊者情報といオープンデータを組み合わせることで宿泊者の特性を明らかにしていきます。2.については、月別・曜日別で傾向を把握した上で、実際に宿泊者数を予測するモデル構築を進めていきます。OLS(最小二乗法)によるモデル構築と階層ベイズによるモデル構築を行い、その精度の比較も行います。

2.地域別宿泊者数

(1)外国

setwd("~/Desktop/256/Rico Project")
W_rico <- read.csv("world_rico.csv",fileEncoding="Shift_JIS",as.is = T)
W_rico <- W_rico[1:19,]
#library(plyr)
#dfct <- join(df2,W_rico,"COUNTRY")
#dfct$RICO[is.na(dfct$RICO)]<-0
#dfct <- dfct[,-4]
# Plot
ggplot(W_rico, aes(reorder(x = 国名, X = RICO), y=RICO,color=エリア)) + 
  geom_point(size=2.2) + 
  geom_segment(aes(x=国名, 
                   xend=国名, 
                   y=0, 
                   yend=RICO),size=1) + 
  labs(title="国別宿泊者数(2016)") + 
  theme(axis.text.x = element_text(angle=65, vjust=0.6))+
  theme_bw(base_family="HiraKakuProN-W3") +
  theme(axis.title.y=element_blank())+
  theme(axis.title.x=element_blank())+
  theme(legend.position = "bottom") +
  scale_color_tq()+
  coord_flip()

## log化
W_rico$関空 <- log(W_rico$関空)

ggplot(W_rico, aes(x =関空 , y = RICO,color=エリア)) +
  geom_point() +
  geom_smooth(colour = "blue",size = 0.6,method = "lm") +
  geom_text_repel(data =W_rico ,
                  family = "HiraKakuPro-W3",
                  aes(label = 国名),
                  size = 3,
                  box.padding = unit(0.3, "lines"),
                  point.padding = unit(0.3, "lines"))+
  theme_bw(base_size=9) +
  theme_bw(base_family="HiraKakuProN-W3")　+
  theme(legend.position = "bottom") +
  labs(title="宿泊者数 vs 入国者数(2016)") + 
  labs(caption="source:総務省「出入国管理統計」") + 
  labs(x = "関西国際空港入国者数(log)", y = "宿泊者数(RICO)")+
  scale_color_tq()

(2)日本

## 指定したwdからcsvを読み込み
setwd("~/Desktop/256/Rico Project")
data <- read.csv("area_sep.csv",header=T,fileEncoding="Shift_JIS",as.is = T)

## tool tipを追加
data$tooltip=paste0(data$region,"
                    number of guests
                    ",data$RICO)
data$data_id=1:nrow(data)

## 2016年 guests
p<-ggplot(data=data,aes(map_id=region))+
  expand_limits(x=Japan1$long,y=Japan1$lat)+
  geom_map_interactive(map=Japan1,colour='gray',size=0.01,
                       aes(fill=RICO,data_id=region,tooltip=tooltip))+
  ggthemes::theme_map() +
  coord_equal(0.9) +
  theme(legend.justification=c(0.7,0), legend.position=c(0.7,0)) +
  scale_fill_gradient(high = "blue4", low = "lightblue3") +
  ggtitle("2016年 都道府県別宿泊者数") +
  theme(plot.title = element_text(hjust = 0.3, vjust=4.12)) 

ggiraph(code=print(p))
## 指定したwdからcsvを読み込み
setwd("~/Desktop/256/Rico Project")
data2 <- read.csv("correl.csv",header=T,fileEncoding="Shift_JIS",as.is = T)

## log化
data2$入込者数 <- log(data2$入込者数)

library(ggrepel)
ggplot(data2, aes(x =入込者数 , y = RICO)) +
  geom_point() +
  geom_smooth(colour = "blue",size = 0.6,method = "lm") +
  geom_text_repel(data =data2 ,
                  family = "HiraKakuPro-W3",
                  aes(label = 地域),
                  size = 3,
                  box.padding = unit(0.3, "lines"),
                  point.padding = unit(0.3, "lines"))+
  theme_bw(base_size=9) +
  theme_bw(base_family="HiraKakuProN-W3")　+
  labs(x = "和歌山市内宿泊者数(log)", y = "宿泊者数(RICO)")+
  labs(caption="source:和歌山県観光客動態調査報告書(2016)")

3.月別でのトレンド

今回は、月別の予測をARIMAモデルを用いて行った。

## まとめて1枚に出力
## 2列に並べる
grid.arrange(F1, F2, F3, F4, 
             ncol = 2) 

grid.arrange(F5, F6, F7, F8, 
             ncol = 2)

4.曜日別のトレンド

全体

外国人宿泊者

日本人宿泊者

5.OLSによるモデル構築

##予測モデル(OLS)
#上記で追加した拡張データを使ってモデリング
base_data <- df_plus_week[,-2:-3]
base_data$August <- ifelse(base_data$month=="8",1,0)
base_data$July <- ifelse(base_data$month=="7",1,0)
base_data$Feburary <- ifelse(base_data$month=="2",1,0)
base_data$Saturday <- ifelse(base_data$wday.lbl=="Saturday",1,0)



## 日本の休日
hoiday16 <- as.data.frame(jholiday(2016))
names(hoiday16)[1]<-"holyday"
hoiday17 <- as.data.frame(jholiday(2017))
names(hoiday17)[1]<-"holyday"
holyday <- rbind(hoiday16,hoiday17)

base_data$holyday <- ifelse(base_data$date %in% holyday$holyday ,1,0)



# 重回帰モデルの構築
fit.lm <- lm(宿泊者数~ +August+July+Feburary+Saturday+holyday, data=base_data)
summary(fit.lm)
## 
## Call:
## lm(formula = 宿泊者数 ~ +August + July + Feburary + Saturday + 
##     holyday, data = base_data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -10.328  -2.341  -1.053   1.947  19.672 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   4.0532     0.2486  16.304  < 2e-16 ***
## August        7.2745     0.6034  12.056  < 2e-16 ***
## July          2.2883     0.6118   3.740 0.000205 ***
## Feburary     -3.2624     1.2892  -2.531 0.011694 *  
## Saturday      4.4155     0.5448   8.105 4.09e-15 ***
## holyday       4.6790     0.9035   5.179 3.24e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 4.394 on 499 degrees of freedom
## Multiple R-squared:  0.3258, Adjusted R-squared:  0.319 
## F-statistic: 48.23 on 5 and 499 DF,  p-value: < 2.2e-16
# 作成したモデルでpredict
# 実測値と適用値のプロット
pred.lm <- predict(fit.lm,base_data[,c("August", "July","Feburary","Saturday","holyday")])

ndata <- cbind(base_data[,c("宿泊者数","August", "July","Feburary","Saturday","holyday")],pred.lm)


ggplot()+
  geom_point(data=ndata,aes(x=宿泊者数, y=pred.lm), size=1,alpha=0.2) +
  labs(title = "最小二乗法 (Ordinary Least Squares)") +
  xlab("実測値") +ylab("予測値")+
  geom_abline(slope = 1,size=0.6,color="darkred")+
  theme_tq() +
  theme_bw(base_family="HiraKakuProN-W3") +
  theme(legend.position = "bottom") +
  scale_color_tq()

6.階層ベイズによるモデル構築

## 実測値と適用値のプロット
ggplot()+
  geom_point(data=ndata_1,aes(x=宿泊者数, y=pred.blm), size=1,alpha=0.2) +
  labs(title = "階層ベイズによる予測") +
  xlab("実測値") +ylab("予測値")+
  geom_abline(slope = 1,size=0.6,color="darkred")+
  theme_tq() +
  theme_bw(base_family="HiraKakuProN-W3") 

## 9月11日〜9月15日を予測
ggplot()+
  geom_point(data=ndata_2,aes(x=宿泊者数, y=pred.blm2), size=1,alpha=0.2) +
  labs(title = "階層ベイズによる予測（9.11 to 9.15）") +
  xlab("実測値") +ylab("予測値")+
  geom_abline(slope = 1,size=0.6,color="darkred")+
  theme_tq() +
  theme_bw(base_family="HiraKakuProN-W3") 

## 誤差が大きい場所
ndata_1$res <- (ndata_1$宿泊者数-ndata_1$pred.blm)
ndata_1 <- cbind(base_data[1:500,1],ndata_1)

ggplot() +
  geom_point(data=ndata_1, aes(x=`base_data[1:500, 1]`, 　y=res),color="navy", size=1,alpha=0.5) +
  ylim(-2,25)+
  xlab("Date") +ylab("予測値と実測値の乖離")+
  theme_bw(base_family="HiraKakuProN-W3") 

library(DT)
names(ndata_1)[1]<-c("date")
ndata_1$pred.lm <- round(ndata_1$pred.lm,2)
ndata_1$pred.blm <- round(ndata_1$pred.blm,2)
ndata_1$res <- round(ndata_1$res,2)
datatable(ndata_1)